;; collection/pt3.scm - (c) rohan drape, 2001-2005

;; A <pt3> is a location in three dimensional space.

(define make-pt3 list)
(define pt3-x    car)
(define pt3-y    cadr)
(define pt3-z    caddr)
(define pt3-ref  list-ref)
(define pt3-set! list-set!)

;; <pt3> comparison.

(define (make-pt3-comparator op)
  (lambdaL ({x1 y1 z1} {x2 y2 z2})
    (and (op x1 x2) (op y1 y2) (op z1 z2))))

(define pt3-=?  (make-pt3-comparator =))
(define pt3->?  (make-pt3-comparator >))
(define pt3->=? (make-pt3-comparator >=))
(define pt3-<?  (make-pt3-comparator <))
(define pt3-<=? (make-pt3-comparator <=))

;; <pt3> binary math.

(define (make-binary-pt3-math op)
  (lambdaL ({x1 y1 z1} {x2 y2 z2})
    (make-pt3 (op x1 x2) (op y1 y2) (op z1 z2))))

(define pt3-+ (make-binary-pt3-math +))
(define pt3-- (make-binary-pt3-math -))
(define pt3-* (make-binary-pt3-math *))
(define pt3-/ (make-binary-pt3-math /))

;; <pt3> unary math.

(define (make-unary-pt3-math op)
  (lambdaL ({x y z})
    (make-pt3 (op x) (op y) (op z))))

(define pt3-negative (make-unary-pt3-math -))
(define pt3-abs      (make-unary-pt3-math abs))
(define pt3-floor    (make-unary-pt3-math floor))
(define pt3-ceiling  (make-unary-pt3-math ceiling))
(define pt3-truncate (make-unary-pt3-math truncate))
(define pt3-round    (make-unary-pt3-math round))

;; <pt3> scalar math.

(defineL (pt3-translate {x y z} n) (make-pt3 (+ x n) (+ y n) (+ z n)))
(defineL (pt3-scale {x y z} n) (make-pt3 (* x n) (* y n) (* z n)))

;; Inverse of `a' about `b'.

(define (pt3-inverse a b) (pt3-+ (pt3-- b a) b))

;; <list> and <vector> translators.

(define (list->pt3 l) l)
(define (pt3->list p) p)

(define (vector->pt3 v) (vector->list v))
(define (pt3->vector p) (list->vector p))

;; Generate a set of <pt3>s on the line from `a' to `b' with an x axis
;; distance increment of `xn'.

(define (pt3-generate-line a b xn)
  (let* ((d (pt3-- b a))
	 (left-right? (> (pt3-x d) 0))
	 (end-test? (if left-right? >= <=))
	 (dx (if left-right? xn (- xn)))
	 (incr (make-pt3 dx
			 (/* (pt3-y d) (/ (pt3-x d) dx))
			 (/* (pt3-z d) (/ (pt3-x d) dx)))))
    (let loop ((line (list a)) (p a))
      (if (end-test? (pt3-x p) (pt3-x b))
	  (reverse line)
	  (let ((z (pt3-+ p incr)))
	    (loop (cons z line) z))))))

;; Linear interpolation at `index' in [0,1) between `left' and
;; `right'.

(defineL (pt3-interpolate {x1 y1 z1} {x2 y2 z2} index)
  (make-pt3 (+ (* index (- x2 x1)) x1)
	    (+ (* index (- y2 y1)) y1)
	    (+ (* index (- z2 z1)) z1)))

;; Binary input and output of <pt3> data.

(define (read-pt3/float32 port)
  (make-pt3 (read-float32 port) 
	    (read-float32 port)
	    (read-float32 port)))

(define (write-pt3/float32 p port)
  (write-float32 (pt3-x p) port)
  (write-float32 (pt3-y p) port)
  (write-float32 (pt3-z p) port))
